#!/usr/bin/perl
use warnings;
use strict;

#******************************************************************************
# File: 
#		perl.pl
# Recipe: 1.1
#		Accessing Substrings
# Version:
#		0.1
# Author:
#   	Yubei Zhu
# Mail:
#		yubeizhu@gmail.com
# Created at:
#   	2012-08-14  
# Last Update:
#   	2012-08-15
# License: 
#		GPLv3	
#******************************************************************************


########################## Access of substring ###########################
# Index    +012345678901234567890
my $sString = "This is what you have";
# R-Index   109876543210987654321-   

# substr( $sString, $sOffset, $sCount )
my $sFirst = substr( $sString, 0, 1 );
my $sLast  = substr( $sString, -1 );

my $sPiece  = substr( $sString, 5, 2 );  # is
my $sRPiece = substr( $sString, -8, 3 ); # reverse piece: you 

my $sRest  = substr( $sString, 13 ); # you have
my $sRRest = substr( $sString, -4 );  # reverse piece: have 

########################## Modify of substring ############################
# substr function is lvaluable one
substr( $sString, 5, 2 ) = "wasn't";  	# is ===> wasn't, 
substr( $sString, -12  ) = "ondrous";  	# hat you have ===> ondrous
substr( $sString, 0, 1 ) = ""; 			# delete the first char
substr( $sString, -10  ) = "";			# delete last 10 chars

print "Modify of string $sString\n";

# Reference of string, doesn't change 
print "Before modify:", \$sString,"\n";
substr( $sString, 0  ) = "^_^"; 	    
print "After modify:", \$sString,"\n";

########################## Pattern match/ Substitution of substring ###########
$sString = "This is what you have";
print "String now: $sString\n";

if ( substr( $sString, -10 ) =~ /have/){# hard code here
	print "Pattern matches in last 10 characters\n";
}

substr( $sString, 0, 5 ) =~ s/is/at/g;  # This ==> that
print "String After substitution: $sString\n";

######################### Swap of substring ####################################
# Recipe 1.3 Exchanging Values Without Using Temporary Variables
$sString = "make a hat";
print "Before swap: $sString\n";
( substr( $sString, 0, 1 ), substr( $sString, -1 ) ) =
( substr( $sString, -1 ), substr( $sString, 0, 1 ) );
print "After swap: $sString\n"; 



########################## Substring using unpack ###############################
# unpack( fmt, string )
# 	x: skip, X: backward skip A: get byte
# byte num  123456789012345789 
$sString = "To be or not to be";
my $sUnpackStr = unpack( "x6 A6 ", $sString ); #skip 6 bytes, then get 6 bytes
print "After unpack: $sUnpackStr\n";  



# Get multiple substrings at a time
# X5: backward skip bytes, A*: Get rest of the bytes
my ( $sStr1, $sStr2, $sStr3 ) = unpack( "x6 A2 X5 A2 A*", $sString );  
print "Multiple substrings: [$sStr1], [$sStr2], [$sStr3]\n";

# scalar context uses the first value
my ( $sScalar ) = unpack( "x6 A2 X5 A2 A*", $sString );  
print "Scalar context: [$sScalar]\n";

sub cut2fmt
#*****************************************************************************
# PURPOSE: 
#       convert the postions cut in string to a format for unpack.
# USAGE:   
#       cut2fmt( 8,14,20 )
# PASSED ARGS:  
#       list: postions want to be cut
# RETURN ARGS:
#       scalar: format string
# $sError - Fail Error Message
#       None
#******************************************************************************
{
	my $sFormat = "";
	my $sLastPos = 1; 	# start from first position
	
	foreach my $sCurrPos ( @_ ){
		$sFormat .= "A" . ( $sCurrPos - $sLastPos ) . " ";
		$sLastPos = $sCurrPos;
	}
	
	$sFormat .= "A*";  	
	return  $sFormat;
}

my $sFmt = cut2fmt( 8, 14 );
my $sFmt1 = cut2fmt( );
print "Format is: $sFmt and $sFmt1\n";
